home *** CD-ROM | disk | FTP | other *** search
/ Aminet 15 / Aminet 15 - Nov 1996.iso / Aminet / util / cli / DoVer.lha / DoVer / src / DoVer.mod < prev    next >
Encoding:
Text File  |  1996-09-28  |  13.2 KB  |  467 lines
  1. (*
  2. (* :Program.    DoVer.mod
  3. ** :Contents.   search $VER and copy them to filecomment
  4. ** :Author.     Bert Jahn
  5. ** :EMail.      jah@boss.hrz.th-zwickau.de
  6. ** :Address.    Franz-Liszt-Straße 16, Rudolstadt, 07404, Germany
  7. ** :History.    V0.1 24.01.95 Beta
  8. **              V1.0 06.03.95
  9. **              V1.1 13.11.95 minor changes
  10. **                   26.11.95 changes in GetResidentID.asm
  11. **                   released on aminet
  12. **                   16.12.95 added PREPEND,APPEND
  13. **              V1.2 released on aminet
  14. **                   23.12.95 added CONVERTDATE
  15. **              V1.3 released on aminet
  16. **                   07.03.96 added SHORT
  17. **              V1.4 released on aminet
  18. **                   15.09.96 complete new parsing of version string
  19. **                            new option FMT/K to set version format from commandline
  20. **                            option SHORT removed because now obsolete
  21. **                            searchloop optimized a bit
  22. **                   17.09.96 CONVERTDATE removed, it's now automatically done if FMT is specified
  23. **              V1.5 released on aminet
  24. **                   28.09.96 min length for formats ("FMT=") added
  25. **                            added multiple files as argument ("FILE/A/M")
  26. **              V1.6 released on aminet
  27. ** :Copyright.  Public Domain
  28. ** :Language.   Oberon
  29. ** :Translator. Amiga Oberon 3.11 (Includes 40.15)
  30. *)
  31. *)
  32.  
  33. (* $ClearVars+ *) (* important; all other switches should turned off *)
  34.  
  35. MODULE DoVer;
  36.  
  37. IMPORT
  38.   SYS  := SYSTEM,
  39.   d    := Dos,
  40.   ds   := DosSupport,
  41.   e    := Exec,
  42.   str  := Strings,
  43.   xfd  := XFDmaster,
  44.   xfds := XFDsupport;
  45.  
  46. CONST
  47.   version  = "$VER: DoVer V1.6 (28.09.96) by Bert Jahn";
  48.   template = "FILE/A/M,FMT/K,DEFAULT/K,FORCE/S,APPEND/S,PREPEND/S,QUIET/S,NOCOMM/S";
  49.  
  50. TYPE
  51.   Args = STRUCT (dummy: d.ArgsStruct)
  52.     file    : d.ArgStringArray;  (* Files to scan *)
  53.     fmt     : d.ArgString;  (* version format *)
  54.     default : d.ArgString;  (* default string for SetComment *)
  55.     force   : d.ArgBool;    (* overwrite old comment *)
  56.     append  : d.ArgBool;    (* append ver onto end of any exist filenote *)
  57.     prepend : d.ArgBool;    (* add ver onto start of any exist filenote *)
  58.     quiet   : d.ArgBool;    (* be quiet, only errmsg output *)
  59.     nocomm  : d.ArgBool;    (* don't set comment *)
  60.   END;
  61.  
  62. VAR
  63.   rd      : d.RDArgsPtr;       (* for ReadArgs *)
  64.   args    : Args;
  65.   buffer  : ARRAY 256 OF CHAR; (* the comment *)
  66.   f       : xfds.FileDescr;
  67.   fileadr : e.LSTRPTR;
  68.   i       : INTEGER;
  69.  
  70.  
  71.  
  72. (* copy string filtered to arrayofchar *)
  73. (*  src     sourcestring
  74.     dest    space for deststring; LEN(dest) must valid ! *)
  75. PROCEDURE ParseString(src: e.LSTRPTR; VAR dest: ARRAY OF CHAR);
  76. VAR
  77.   s,d,e,z : LONGINT;
  78.   name,ver,date,ext : ARRAY 128 OF CHAR;
  79.   day,mon,year,t : INTEGER;
  80.   c : CHAR;
  81. TYPE
  82.   MonthType = ARRAY 12 OF ARRAY 4 OF CHAR;
  83. CONST
  84.   month  = MonthType ("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec"); (* english *)
  85.   monthg = MonthType ("Jan","Feb","Mär","Apr","Mai","Jun","Jul","Aug","Sep","Okt","Nov","Dez"); (* german *)
  86.  
  87.   (* transform string(date) to integer, returns endpos of int *)
  88.   PROCEDURE Str2Int(VAR x: INTEGER):BOOLEAN;
  89.   BEGIN
  90.     x := 0;
  91.     LOOP
  92.       c := date[s];
  93.       IF (c>='0') & (c<='9') THEN
  94.         x := 10 * x + ORD(c) - ORD('0');
  95.         INC(s);
  96.       ELSE
  97.         IF x=0 THEN
  98.           RETURN FALSE;
  99.         ELSE
  100.           RETURN TRUE;
  101.         END;
  102.       END;
  103.     END;
  104.   END Str2Int;
  105.  
  106.   (* append one character to dest[], returns true if buffer is full *)
  107.   PROCEDURE CatChar(ch: CHAR): BOOLEAN;
  108.   BEGIN
  109.     IF d >= LEN(dest)-1 THEN
  110.       IF e # 0 THEN          (* buffer full -> seems it's a text file *)
  111.         d := e;              (* use earlier LF for terminating *)
  112.       ELSE
  113.         d := LEN(dest)-1
  114.       END;
  115.       RETURN TRUE;
  116.     ELSE
  117.       IF (d#0) OR (ch#' ') THEN (* to overread the first space *)
  118.         dest[d] := ch;
  119.         INC(d);
  120.       END;
  121.       RETURN FALSE;
  122.     END;
  123.   END CatChar;
  124.  
  125.   (* append an integer value as ascii to string *)
  126.   PROCEDURE AppendInt(VAR s:ARRAY OF CHAR; i:INTEGER; min:LONGINT);
  127.   VAR
  128.     b : ARRAY 5 OF INTEGER; (* max 5 digits ! *)
  129.     c : INTEGER;
  130.   BEGIN
  131.     c := 0;
  132.     REPEAT
  133.       b[c] := i MOD 10;
  134.       i := i DIV 10;
  135.       INC(c);
  136.     UNTIL i = 0;
  137.     WHILE min>c DO          (* prepend SPACE's if required *)
  138.       str.AppendChar(s,' ');
  139.       DEC(min);
  140.     END;
  141.     REPEAT
  142.       DEC(c);
  143.       str.AppendChar(s,CHR(ORD('0')+b[c]));
  144.     UNTIL c = 0;
  145.   END AppendInt;
  146.  
  147.   (* append string to string with minimum length *)
  148.   PROCEDURE AppendStr(VAR s1:ARRAY OF CHAR; VAR s2:ARRAY OF CHAR; min:LONGINT);
  149.   VAR
  150.     l : LONGINT;
  151.   BEGIN
  152.     l := str.Length(s2);
  153.     WHILE min>l DO
  154.       str.AppendChar(s1,' ');
  155.       DEC(min);
  156.     END;
  157.     str.Append(s1,s2);
  158.   END AppendStr;
  159.  
  160.  
  161. BEGIN
  162.   (* first remove all conrol codes and find end of string *)
  163.   LOOP
  164.     CASE src[s] OF
  165.       0X        : EXIT;                             (* end reached *)
  166.     | 1X .. 8X  : ;                                 (* ignore *)
  167.     | 9X        : IF CatChar(' ') THEN EXIT END;    (* tabulator -> space *)
  168.     | 0AX       : IF CatChar(' ') THEN EXIT END; IF (e = 0) THEN e := d; END; (* save pos of LF terminating *)
  169.     | 0BX..1FX  : ;                                 (* ignore *)
  170.     | 0A0X      : IF CatChar(' ') THEN EXIT END;    (* whitespace -> space *)
  171.       ELSE        IF CatChar(src[s]) THEN EXIT END; (* copy *)
  172.     END;
  173.     INC(s);
  174.   END;
  175.   dest[d] := 0X;  (* terminate buffer *)
  176.  
  177.   (* check for users format *)
  178.   IF args.fmt = NIL THEN RETURN END;
  179.  
  180.   (* now split the string off *)
  181.   s:=0;
  182.   (* get name *)
  183.   d:=0;
  184.   WHILE ( (d<LEN(name)-1) AND (dest[s]#0X) AND (dest[s]#' ') ) DO
  185.     name[d]:=dest[s];
  186.     INC(d); INC(s);
  187.   END;
  188.   name[d]:=0X;
  189.   (* get version *)
  190.   WHILE ( (dest[s]=' ') OR (dest[s]='v') OR (dest[s]='V') ) DO INC(s); END;
  191.   d:=0;
  192.   WHILE ( (d<LEN(ver)-1) AND (dest[s]#0X) AND (dest[s]#' ') ) DO
  193.     ver[d]:=dest[s];
  194.     INC(d); INC(s);
  195.   END;
  196.   ver[d]:=0X;
  197.   (* get date *)
  198.   WHILE dest[s]=' ' DO INC(s); END;
  199.   d:=0;
  200.   WHILE ( (d<LEN(date)-1) AND (dest[s]#0X) AND ~((date[0]='(') AND (date[d-1]=')')) AND ~((date[0]#'(') AND (dest[s]=' ')) ) DO
  201.     date[d]:=dest[s];
  202.     INC(d); INC(s);
  203.   END;
  204.   date[d]:=0X;
  205.   (* get extra *)
  206.   WHILE dest[s]=' ' DO INC(s); END;
  207.   d:=0;
  208.   WHILE ( (d<LEN(ext)-1) AND (dest[s]#0X) ) DO
  209.     ext[d]:=dest[s];
  210.     INC(d); INC(s);
  211.   END;
  212.   ext[d]:=0X;
  213.  
  214.   (* decode the datestamp *)
  215.   s := 0;
  216.   WHILE (date[s]='(') OR (date[s]=' ') DO INC(s); END;
  217.   IF ~ Str2Int(day) THEN
  218.     (* Dec  1 1992 *)
  219.     t := 0;
  220.     WHILE t<12 DO
  221.       IF (date[s]=month[t][0]) AND (date[s+1]=month[t][1]) AND (date[s+2]=month[t][2]) THEN mon:=t+1; END;
  222.       INC(t);
  223.     END;
  224.     IF mon # 0 THEN
  225.       WHILE (date[s]#0X) AND ((date[s]<'0') OR (date[s]>'9')) DO INC(s); END;
  226.       IF Str2Int(day) THEN END;
  227.       IF date[s]=' ' THEN INC(s); END;
  228.     END;
  229.   ELSE
  230.     (* 1.12.92 *)
  231.     IF date[s]#0X THEN INC(s) END;
  232.     IF ~ Str2Int(mon) THEN
  233.       (* 1-Dec-92 *)
  234.       t := 0;
  235.       WHILE t<12 DO
  236.         IF (date[s]=month[t][0]) AND (date[s+1]=month[t][1]) AND (date[s+2]=month[t][2]) THEN mon:=t+1; END;
  237.         INC(t);
  238.       END;
  239.       IF mon = 0 THEN
  240.         (* 1-Dez-92 german *)
  241.         t := 0;
  242.         WHILE t<12 DO
  243.           IF (date[s]=monthg[t][0]) AND (date[s+1]=monthg[t][1]) AND (date[s+2]=monthg[t][2]) THEN mon:=t+1; END;
  244.           INC(t);
  245.         END;
  246.       END;
  247.     END;
  248.     WHILE (date[s]#0X) AND ((date[s]<'0') OR (date[s]>'9')) DO INC(s); END;
  249.   END;
  250.   IF (day # 0 ) AND (mon # 0) THEN
  251.     IF Str2Int(year) THEN
  252.       IF day > 31 THEN t:=day;day:=year;year:=t; END; (* swap day - year *)
  253.       IF year > 99 THEN DEC(year,1900); END;  (* 1992 *)
  254.       IF year > 99 THEN DEC(year,100); END;   (* 2010 *)
  255.     END;
  256.   END;
  257.  
  258.   IF (ver[0]>='0') AND (ver[0]<='9') AND (day>0) AND (day<=31)  AND (mon>0) AND (mon<=12) AND (year<100) THEN
  259.     (* build final version string *)
  260.     dest[0] := 0X;
  261.     t := 0;
  262.     WHILE args.fmt^[t] # 0X DO
  263.       IF args.fmt^[t] = '%' THEN
  264.         c := args.fmt^[t+1];
  265.         s := 0;
  266.         WHILE (c>='0') AND (c<='9') DO
  267.           s := 10 * s + ORD(c) - ORD('0');
  268.           INC(t);
  269.           c := args.fmt^[t+1];
  270.         END;
  271.         CASE args.fmt^[t+1] OF
  272.           'n' : AppendStr(dest,name,s);
  273.         | 'v' : AppendStr(dest,ver,s);
  274.         | 'd' : AppendInt(dest,day,s);
  275.         | 'm' : AppendInt(dest,mon,s);
  276.         | 'M' : AppendStr(dest,month[mon-1],s);
  277.         | 'y' : AppendInt(dest,year,s);
  278.         | 'Y' : IF year >= 78 THEN
  279.                   AppendInt(dest,year+1900,s);
  280.                 ELSE
  281.                   AppendInt(dest,year+2000,s);
  282.                 END;
  283.         | 'e' : AppendStr(dest,ext,s);
  284.         | '%' : str.AppendChar(dest,'%');
  285.         | 0X  : DEC(t);
  286.           ELSE ;
  287.         END;
  288.         INC(t);
  289.       ELSE
  290.         str.AppendChar(dest,args.fmt^[t]);
  291.       END;
  292.       INC(t);
  293.     END;
  294.   END;
  295.  
  296. END ParseString;
  297.  
  298.  
  299.  
  300. (* relocate the file if possible and search for resident structure *)
  301. PROCEDURE CheckResident(VAR src: ARRAY OF CHAR; srclen: LONGINT; VAR dest: ARRAY OF CHAR): BOOLEAN;
  302. VAR
  303.   str  : e.LSTRPTR;
  304.   bptr : e.BPTR;
  305.   ret  : BOOLEAN;
  306.   xerr : e.UWORD;
  307.  
  308.   (* Sorry, I failed to write this in Oberon ! *)
  309.   (* searchs for resident structure and return address of idstring if found *)
  310.   (* see GetResidentID.asm for source *)
  311.   PROCEDURE GetResidentID {"_GetResidentID"} (segment {8}:e.BPTR): e.APTR;
  312.   (* $JOIN GetResidentID.o *)
  313.  
  314. BEGIN
  315.   (* $IFNOT ClearVars *) ret := FALSE; (* $END *)
  316.   IF (srclen >= 3) & (src[3] = 0F3X) THEN     (* is't an executable ? *)
  317.     IF xfd.base # NIL THEN
  318.       xerr := xfd.Relocate(srclen,xfd.relDefault,SYS.ADR(src),bptr);
  319.       IF xerr # xfd.errOk THEN
  320.         d.PrintF("relocating error: %s\n",xfd.GetErrorText(xerr));
  321.       ELSE
  322.         str := GetResidentID(bptr);
  323.         IF str # NIL THEN
  324.           ParseString(str,dest);   (* no sizecheck because possible string outside first segment ... *)
  325.           ret := TRUE;
  326.         END;
  327.         d.UnLoadSeg(bptr);
  328.       END
  329.     END;
  330.   END;
  331.   RETURN ret;
  332. END CheckResident;
  333.  
  334.  
  335.  
  336. (* search the VerString in "src" and copy them to "dest" if found *)
  337. (* "srclen" is used instead of LEN(src) so "src" can be "e.LSTRPTR^" or "e.APTR^" *)
  338. PROCEDURE CheckVerStr(VAR src: ARRAY OF CHAR; srclen: LONGINT; VAR dest: ARRAY OF CHAR): BOOLEAN;
  339. VAR
  340.   ret : BOOLEAN;   (* RETURN Code *)
  341.   a   : LONGINT;   (* offsets in array *)
  342. BEGIN
  343.   (* $IFNOT ClearVars *) ret := FALSE; a := 0; (* $END *)
  344.   DEC(srclen,6);  (* opt *)
  345.   WHILE (~ ret) & (a < srclen) DO
  346.     IF src[a]="$" THEN
  347.       INC(a);
  348.       IF (src[a]="V") OR (src[a]="v") THEN
  349.         INC(a);
  350.         IF (src[a]="E") OR (src[a]="e") THEN
  351.           INC(a);
  352.           IF (src[a]="R") OR (src[a]="r") THEN
  353.             INC(a);
  354.             IF (src[a]=":") THEN ret := TRUE; END;
  355.           END
  356.         END
  357.       END
  358.     ELSE
  359.       INC(a);
  360.     END;
  361.   END;
  362.   IF ret THEN
  363.     INC(a);
  364.     ParseString(SYS.ADR(src[a]),dest);
  365.   END;
  366.   RETURN ret;
  367. END CheckVerStr;
  368.  
  369.  
  370.  
  371. (* set the file comment *)
  372. PROCEDURE SetComment(VAR comment: ARRAY OF CHAR);
  373. VAR
  374.   lock : d.FileLockPtr;
  375.   fib  : d.FileInfoBlockPtr;
  376.   set  : BOOLEAN;
  377.   cmt  : ARRAY 79 OF CHAR;
  378. BEGIN
  379.   IF args.nocomm = 0 THEN
  380.     (* $IFNOT ClearVars *) set := FALSE; (* $END *)
  381.     cmt[0] := 0X; str.Append(cmt,comment);
  382.     IF args.force # 0 THEN
  383.       set := TRUE;
  384.     ELSE
  385.       lock := d.Lock(args.file[i]^,d.accessRead);
  386.       IF lock = NIL THEN
  387.         ds.PrintFault;
  388.       ELSE
  389.         NEW(fib);
  390.         IF fib = NIL THEN
  391.           ds.PrintMemErr;
  392.         ELSE
  393.           IF ~ d.Examine(lock,fib^) THEN
  394.             ds.PrintFault;
  395.           ELSE
  396.             IF args.append # 0 THEN
  397.               cmt[0] := 0X; str.Append(cmt,fib.comment);
  398.               str.Append(cmt," ");
  399.               str.Append(cmt,comment);
  400.               set:=TRUE;
  401.             ELSIF args.prepend #0 THEN
  402.               str.Append(cmt," ");
  403.               str.Append(cmt,fib.comment); set:=TRUE;
  404.             ELSIF fib.comment[0] = 0X THEN
  405.               set := TRUE;
  406.             END;
  407.           END;
  408.           DISPOSE(fib);
  409.         END;
  410.         d.UnLock(lock);
  411.       END
  412.     END;
  413.     IF set THEN
  414.       IF ~ d.SetComment(args.file[i]^,cmt) THEN ds.PrintFault; END;
  415.     END
  416.   END
  417. END SetComment;
  418.  
  419.  
  420.  
  421. PROCEDURE PrintMsg(str: e.LSTRPTR);
  422. BEGIN
  423.   IF args.quiet = 0 THEN
  424.     d.PrintF("%s\t- %s\n",args.file[i],str);
  425.   END
  426. END PrintMsg;
  427.  
  428.  
  429.  
  430. (* main *)
  431. BEGIN
  432.   SYS.SETREG(8,SYS.ADR(version));    (* that the version string will linked *)
  433.   IF d.base.lib.version < 37 THEN
  434.     HALT(20);
  435.   ELSE
  436.     rd := d.ReadArgs(template,args,NIL);
  437.     IF rd = NIL THEN
  438.       ds.PrintFault;
  439.     ELSE
  440.       IF args.force + args.append + args.prepend < -1  THEN   (* it's not fine but works *)
  441.         d.PrintF("only one of FORCE APPEND PREPEND can specified\n");
  442.       ELSE
  443.         WHILE args.file[i] # NIL DO
  444.           f.name := args.file[i];
  445.           f.passwd := NIL;               (* no passwd support *)
  446.           IF xfds.LoadFile(f) THEN
  447.             fileadr := f.address;
  448.             IF CheckVerStr(fileadr^,f.size,buffer) OR CheckResident(fileadr^,f.size,buffer) THEN
  449.               PrintMsg(SYS.ADR(buffer));
  450.               SetComment(buffer);
  451.             ELSE
  452.               PrintMsg(SYS.ADR("No VersionString found"));
  453.               IF args.default # NIL THEN
  454.                 SetComment(args.default^);
  455.               END
  456.             END;
  457.             xfds.UnLoadFile(f);
  458.           END;
  459.           INC(i);
  460.         END;
  461.       END;
  462.       d.FreeArgs(rd);
  463.     END
  464.   END
  465. END DoVer.
  466.  
  467.